perm filename EXPAND.F4[PIC,LCS] blob
sn#637515 filedate 1982-01-24 generic text, type T, neo UTF8
00100 C EXPAND.F4
00200 INTEGER TOTL,TOTOUT
00300 COMMON /XYZ/X(650),Y(650),Z(650)
00400 COMMON /OUTL/OX(650),OY(650),OZ(650)
00500 COMMON /S/SL(650),P(650)
00600 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
00700 C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
00800 C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
00900 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
01000 COMMON/I/ I(3000)
01100 1 CALL DPYSET(1,I,3000)
01200 TOTL=0
01300 DDY=0
01400 DDX=0
01500 TOTOUT=0
01600 CALL READRW
01700 C READ IN THE DRAWING
01800 IB=1
01900 DDX=100
02000 CALL DPY(X,Y,Z,TOTL)
02100 2 CALL RDOUTL
02200 C READ IN THE OUTLINE
02300 IB=1
02400 IF(DDY.NE.0)GO TO 6
02500 C JUMP IF DOING DRAWING TRANSITION.
02600 CALL DPY(OX,OY,OZ,TOTOUT)
02700 3 CALL MAKNEW
02800 C EXPAND THE DRAWING
02900 7 IB=6
03000 C MAKE EXPANDED IMAGE BRIGHTER (IB=6)
03100 4 CALL DPY(X,Y,Z,TOTL)
03200 5 CALL SAVIT
03300 GO TO 1
03400 6 CALL TRNSIT
03500 GO TO 7
03600 END
03700
03800 SUBROUTINE MAKNEW
03900 INTEGER TOTL,TOTOUT,HIT
04000 COMMON /XYZ/X(650),Y(650),Z(650)
04100 COMMON /OUTL/OX(650),OY(650),OZ(650)
04200 COMMON /S/SL(650),P(650)
04300 COMMON /CCC/G
04400 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
04500 10 FORMAT(' CX=',F6.3,' CY=',F6.3)
04600 11 FORMAT(' X,Y,Z = '2F8.3,F3.0)
04700 TYPE 10,CX,CY
04800 CC DO 12 K=1,TOTL
04900 CC12 TYPE 11,X(K),Y(K),Z(K)
05000 K=1
05100 1 DO 2 J=2,TOTOUT
05200 IF(HIT(J,OX,OY,K,A,B).LT.0)GO TO 2
05300 C NOW RESET COORDS.
05400 X(K)=CX+(A-CX)*P(K)*G
05500 Y(K)=CY+(B-CY)*P(K)*G
05600 CX X(K)=X(K)+(A-X(K))*G*P(K)
05700 C Y(K)=Y(K)+(B-Y(K))*G*P(K)
05800 C P = % OF LONGEST LINE FROM CENTER TO A POINT.
05900 CC13 TYPE 11,X(K),Y(K),Z(K)
06000 IF(K.EQ.TOTL)RETURN
06100 K=K+1
06200 GO TO 1
06300 2 CONTINUE
06400 END
06500
06600 INTEGER FUNCTION HIT(J,OX,OY,K,A,B)
06700 DIMENSION OX(1),OY(1)
06800 INTEGER TOTL,TOTOUT,HIT
06900 COMMON /XYZ/X(650),Y(650),Z(650)
07000 CC COMMON /OUTL/OX(650),OY(650)
07100 COMMON /S/SL(650),P(650)
07200 COMMON TOTL,CX,CY,LF,RT,TOP,BOT
07300 RX=OX(J-1)
07400 SX=OX(J)
07500 RY=OY(J-1)
07600 SY=OY(J)
07700 IF(RX.LE.SX)GO TO 2
07800 SX=RX
07900 RX=OX(J)
08000 SY=RY
08100 RY=OY(J)
08200 2 TY=RY
08300 UY=SY
08400 IF(TY.LE.UY)GO TO 4
08500 UY=RY
08600 TY=SY
08700 C TY=BOTTOM, UY =TOP, RX=LEFT, SX=RIGHT
08800 4 C=SX-RX
08900 IF(C.EQ.0)GO TO 1
09000 SS=(SY-RY)/C
09100 C SLOPE OF THIS LINE
09200 A=(RY-CY-SS*RX+SL(K)*CX)/(SL(K)-SS)
09300 B=SS*(A-RX)+RY
09400 5 HIT=-1
09500 C A MISS
09600 IF(A.LT.RX.OR.A.GT.SX)RETURN
09700 IF(B.LT.TY.OR.B.GT.UY)RETURN
09800 IF(Y(K).LT.CY.AND.CY.LT.B)RETURN
09900 IF(Y(K).GT.CY.AND.CY.GT.B)RETURN
10000 IF(X(K).LT.CX.AND.CX.LT.A)RETURN
10100 IF(X(K).GT.CX.AND.CX.GT.A)RETURN
10200 HIT=0
10300 C A HIT
10400 RETURN
10500 1 B=SL(K)*(SX-CX)+CY
10600 A=RX
10700 GO TO 5
10800 END
10900
11000 SUBROUTINE DPY(X,Y,Z,L)
11100 INTEGER TOTL,TOTOUT
11200 DIMENSION X(1),Y(1),Z(1)
11300 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
11400 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
11500 C MAKE EXPANDED IMAGE BRIGHTER
11600 CALL DPYBRT(IB)
11700 Q=0
11800 IF(IB.GT.4)Q=500
11900 10 DO 1 K=1,L
12000 M=DSZ*X(K)+.5-DDX
12100 N=DSZ*Y(K)+.5-Q
12200 IF(Z(K).NE.0)GO TO 2
12300 CALL AVECT(M,N)
12400 GO TO 1
12500 2 CALL AIVECT(M,N)
12600 1 CONTINUE
12700 CALL DPYOUT(1)
12800 END
12900
13000 SUBROUTINE SAVIT
13100 INTEGER TOTL
13200 COMMON /XYZ/X(650),Y(650),Z(650)
13300 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
13400 COMMON/NM2/NM2
13500 CALL IO(3)
13600 IF(NM2.EQ.' ')RETURN
13700 DO 1 K=1,TOTL
13800 A=X(K)
13900 B=.5
14000 IF(A.LT.0)B=-B
14100 L=A+B
14200 A=Y(K)
14300 B=.5
14400 IF(A.LT.0)B=-B
14500 M=A+B
14600 N=Z(K)
14700 1 WRITE(20,2)K,L,M,N
14800 END FILE 20
14900 2 FORMAT(1I4,2I5,1I3)
15000 END
15100
15200 SUBROUTINE TRNSIT
15300 INTEGER TOTL,TOTOUT
15400 COMMON /XYZ/X(650),Y(650),Z(650)
15500 COMMON /OUTL/OX(650),OY(650),OZ(650)
15600 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
15700 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
15800 DDX=600
15900 CALL DPY(OX,OY,OZ,TOTOUT)
16000 DO 1 K=1,TOTL
16100 X(K)=X(K)-(X(K)-OX(K))*CCX
16200 1 Y(K)=Y(K)-(Y(K)-OY(K))*CCY
16300 DDX=350
16400 END